home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / basappl9.arc / TIMECALC.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-08-04  |  24.5 KB  |  545 lines
  1. 1  ' (PC)^3 Software Submission TIMECALC authored on February 14, 1983 by
  2. 2  '
  3. 3  ' Michael Csontos, 3228 Livonia Center Road, Lima, New York 14485
  4. 4  '
  5. 5  ' Copyright 1983 Michael Csontos
  6. 6  '
  7. 7  '  This program is made freely available non-exclusively to the Picture
  8. 8  '  City Personal Computer Programmers' Club for distribution to its members
  9. 9  '  and through software exchange to other users groups as long as credit is
  10. 10  ' given to the author and (PC)^3.
  11. 11  '
  12. 12  '
  13. 13  ' NOTE: The file TIMECALC.DOC  is associated with this program.
  14. 15  '
  15. 16  '
  16. 10000  CLEAR ,,2000:KEY OFF:CLS:WIDTH 80:WIDTH "lpt1:",255:SCREEN 0,0,0:COLOR 7,0:LOCATE ,,0:DEFINT A-Z:DEF SEG=&HB800:DIM MES$(40)
  17. 10100  DN$(1)="SAT.":DN$(2)="SUN.":DN$(3)="MON.":DN$(4)="TUE.":DN$(5)="WED.":DN$(6)="THU.":DN$(7)="FRI."
  18. 10200  DIM MN$(12):MN$(1)="JAN.":MN$(2)="FEB.":MN$(3)="MAR.":MN$(4)="APR.":MN$(5)="MAY.":MN$(6)="JUN.":MN$(7)="JUL.":MN$(8)="AUG.":MN$(9)="SEP.":MN$(10)="OCT.":MN$(11)="NOV.":MN$(12)="DEC."
  19. 10300  'GOTO 11600'-------------temporary skip description screen---------------
  20. 10400  PRINT " This program allows you to make calculations with time (years, weeks, days,":PRINT
  21. 10500  PRINT " hours, minutes and seconds), whole or decimal, with the ease of a pocket":PRINT
  22. 10600  PRINT " calculator.  You will be presented with a screen form which you fill out":PRINT
  23. 10700  PRINT " using the cursor control keys <"CHR$(24)"> <"CHR$(25)"> <"CHR$(26)"> <"CHR$(27)"> to reach the blanks and":PRINT
  24. 10800  PRINT " numeric keys to fill them in.":PRINT
  25. 10900  PRINT " After entering a number you may use <"CHR$(17)CHR$(196)CHR$(217)"> to cause the results to be ":PRINT
  26. 11000  PRINT " calculated or the cursor keys to move to another part of the entry line.":PRINT
  27. 11100  PRINT " Once the blanks are filled, new calculations can be made by changing any":PRINT
  28. 11200  PRINT " of them and pressing <"CHR$(17)CHR$(196)CHR$(217)">":PRINT
  29. 11300  PRINT " Before running the program you may program the function keys with frequently ":PRINT
  30. 11400  PRINT " used constants with the BASIC command {KEY #,"CHR$(34)"------"CHR$(34)"}.  Pressing <Alt>+<F1>":PRINT
  31. 11500  PRINT " during the program will list function key operations on screen line 25."
  32. 11600  MES$(1)= "Please press any key to continue except press <Esc> to end the program.        "
  33. 11700  MES$(2)= " Use <"+CHR$(24)+"><"+CHR$(25)+"><"+CHR$(26)+"><"+CHR$(27)+"> keys to move, <"+CHR$(17)+CHR$(196)+CHR$(217)+"> key to calculate, <Esc> to end.         "
  34. 11800  MES$(3)= " Use <"+CHR$(26)+">, <"+CHR$(27)+"> and <space bar> to select the function.                       "
  35. 11900  MES$(4)= " <Alt>+<F1> will list all of the function key functions on screen line 25.     "
  36. 12000  MES$(5)= " <Alt>+<F2> will clear the data entry field at the location of the pointer.    "
  37. 12100  MES$(6)= " <Alt>+<F3> will transfer the result line to the first input data line.        "
  38. 12200  MES$(7)= " <Alt>+<F4> will clear data from the entire data line containing the pointer.  "
  39. 12300  MES$(8)= " <Alt>+<F5> will transfer the result line to the last input data line.         "
  40. 12400  MES$(9)= " <Alt>+<F6> duplicates the function of the <"+CHR$(24)+"> key {CURSOR UP}.               "
  41. 12500  MES$(10)= " <Alt>+<F7> duplicates the function of the <"+CHR$(27)+"> key {CURSOR LEFT}.             "
  42. 12600  MES$(11)= " <Alt>+<F8> duplicates the function of the <"+CHR$(26)+"> key {CURSOR RIGHT}.            "
  43. 12700  MES$(12)= " <Alt>+<F9> duplicates the function of the <Del> key.                          "
  44. 12800  MES$(13)= " <Alt>+<F10> duplicates the function of the <"+CHR$(25)+"> key {CURSOR DOWN}.             "
  45. 12900  MES$(14)= " <shift>+<F1> will store the first data line in a temporary register.          "
  46. 13000  MES$(15)= " <shift>+<F2> will recall the stored first data line to the first data line.   "
  47. 13100  MES$(16)= " <shift>+<F3> will store the constant used for multiplication or division.     "
  48. 13200  MES$(17)= " <shift>+<F4> will recall the constant used for multiplication & division.     "
  49. 13300  MES$(18)= " <shift>+<F5> will store the last data line in a temporary register.           "
  50. 13400  MES$(19)= " <shift>+<F6> will recall the stored last data line to the last data line.     "
  51. 13500  MES$(20)= " <shift>+<F7> will store the result data line in a temporary register.         "
  52. 13600  MES$(21)= " <shift>+<F8> will recall the stored result data line to the result data line. "
  53. 13700  MES$(22)= " <shift>+<F9> will cause the printer to print a report of the calculation.     "
  54. 13800  MES$(23)= " <shift>+<F10> will start (stop) a running log of calculations on the printer. "
  55. 13900  MES$(24)= " <Ctrl>+<F1> will exchange the two input time data lines (for subtraction).    "
  56. 14000  MES$(25)= " <Ctrl>+<F2> will make the printer print a list of the function key functions. "
  57. 14100  MES$(26)= " <Ctrl>+<F3> will place the current time of day into the first data line.      "
  58. 14200  MES$(27)= " <Ctrl>+<F4> will place the current time of day into the last input data line. "
  59. 14300  MES$(28)= " <Ctrl>+<F5> will enter the day of the year into the first input data line.    "
  60. 14400  MES$(29)= " <Ctrl>+<F6> will enter the day of the year into the last input data line.     "
  61. 14500  MES$(30)= " <Ctrl>+<F7> will convert the result to a date from the start of the year.     "
  62. 14600  MES$(31)= " <Ctrl>+<F8> will convert the result to a date from the current date.          "
  63. 14700  MES$(32)= " <Ctrl>+<F9> is unassigned                                                     "
  64. 14800  MES$(33)= " <Ctrl>+<F10> is unassigned                                                    "
  65. 14900  MES$(34)= " <F1> - <F10> may be programed with numbers using [KEY n,"+CHR$(34)+"N...N"+CHR$(34)+"] before [RUN]."
  66. 15000  MES$(35)= " The result would be negative!  Use <Ctrl>+<F1> to exchange input data lines.  "
  67. 15100  MES$(36)= " The printer is off line or something! Fix the problem and try again.          "
  68. 15200  MES$(37)= "                                                                               "
  69. 15300  'GOTO 15900'-------------temporary skip to data screen-------------------
  70. 15400  LOCATE 25,1:COLOR 0,7:PRINT MES$(1);:COLOR 7,0
  71. 15500  X$=INKEY$:IF X$="" THEN 15500 ELSE IF X$=CHR$(27) THEN 15600 ELSE 15900
  72. 15600  COLOR 7,0:KEY ON:CLS:ON ERROR GOTO 15700:LPRINT CHR$(27)CHR$(64)CHR$(27)CHR$(48)CHR$(15):ON ERROR GOTO 0:END'--------end---------------------
  73. 15700  RESUME 15800
  74. 15800  ON ERROR GOTO 0:END
  75. 15900  CLS:LOCATE 25,1:COLOR 0,7:PRINT STRING$(79," ");:COLOR 7,0:LOCATE 1,1
  76. 16000  PRINT " Fill in the first entry in the calculation.":PRINT
  77. 16100  BL$=STRING$(4,CHR$(219)):BS$=STRING$(2,CHR$(219))
  78. 16200  PRINT BL$" YEARS, "BL$" WEEKS, "BL$" DAYS, "BL$" HOURS, "BL$" MINUTES, "BL$BL$BS$" SECONDS":PRINT
  79. 16300  GOSUB 28200:PRINT:PRINT
  80. 16400  PRINT "Enter the second number:      "BL$;BL$"  (decimal)  or":PRINT
  81. 16500  PRINT BL$" YEARS, "BL$" WEEKS, "BL$" DAYS, "BL$" HOURS, "BL$" MINUTES, "BL$BL$BS$" SECONDS"
  82. 16600  PRINT STRING$(79,"-")
  83. 16700  PRINT "The result is: "BL$;BL$;BL$" YEARS   "BL$BL$BL$" WEEKS   "BL$;BL$;BL$" DAYS, OR":PRINT
  84. 16800  PRINT BL$" YEARS, "BL$" WEEKS, "BL$" DAYS, "BL$" HOURS, "BL$" MINUTES, "BL$BL$BL$" SEC.":PRINT
  85. 16900  PRINT "    "BL$;BL$;BL$" WEEKS, "BL$" DAYS, "BL$" HOURS, "BL$" MINUTES, "BL$BL$BL$" SEC.":PRINT
  86. 17000  PRINT "                "BL$;BL$;BL$" DAYS, "BL$" HOURS, "BL$" MINUTES, "BL$BL$BL$" SEC.":PRINT
  87. 17100  PRINT BL$;BL$;BL$" HOURS, OR     "BL$BL$BL$" HOURS, "BL$" MINUTES, "BL$BL$BL$" SEC.":PRINT
  88. 17200  PRINT BL$;BL$;BL$" MINUTES, OR               "BL$BL$BL$" MINUTES, "BL$BL$BL$" SEC.":PRINT
  89. 17300  PRINT BL$;BL$;BL$" SECONDS, or                                     "BL$;BL$;BL$" SEC.
  90. 17400  GOSUB 29000' set up pointers
  91. 17500  LOCATE 25,1:COLOR 0,7:PRINT MES$(2);:LOCATE 3,51:POKE 423,&H8F
  92. 17600  X$=INKEY$
  93. 17700  IF X$="" THEN IF ET<>0 THEN GOTO 59200 ELSE 17600 ELSE IF X$=CHR$(27) THEN 15600 ELSE IF X$=CHR$(13) THEN ET=0:GOTO 32600 ELSE IF LEN(X$)>1 THEN 17800 ELSE 21300
  94. 17800  C=ASC(RIGHT$(X$,1)):L=CSRLIN:R=POS(0)'----------two byte keys------------
  95. 17900  POKE (160*(L-1)+2*R+1),0
  96. 18000  IF C=72 OR C=109 THEN GOSUB 23800'cursor up
  97. 18100  IF C=75 OR C=110 THEN GOSUB 24600'cursor left
  98. 18200  IF C=77 OR C=111 THEN GOSUB 26100'cursor right
  99. 18300  IF C=80 OR C=113 THEN GOSUB 27600'cursor down
  100. 18400  L=CSRLIN:R=POS(0):A=(160*(L-1)+2*R+1):POKE A,&H8F:A=A-3
  101. 18500  IF ((C>71 AND C<81) OR (C>108 AND C<114)) AND C><112 THEN 17600
  102. 18600  IF (C=83 OR C=112) AND L<>5 THEN 32400' delete
  103. 18700  IF C=104 THEN GOTO 45100'list function key functions
  104. 18800  IF C=105 AND L<>5 THEN GOSUB 44800'clear field
  105. 18900  IF C=106 THEN 45600' transfer line 13 to line 3
  106. 19000  IF C=107 AND L<>5 THEN 48000'clear line
  107. 19100  IF C=108 THEN 45600' transfer line 13 to line 9
  108. 19200  IF C=84 THEN 53300'store line 3
  109. 19300  IF C=85 THEN 53600'recall line 3
  110. 19400  IF C=86 THEN 53900'store  line 7
  111. 19500  IF C=87 THEN 54200'recall line 7
  112. 19600  IF C=88 THEN 54500'store  line 9
  113. 19700  IF C=89 THEN 54800'recall line 9
  114. 19800  IF C=90 THEN 55100'store  line 13
  115. 19900  IF C=91 THEN 55400'recall line 13
  116. 20000  IF C=92 THEN 48400' print report
  117. 20100  IF C=93 THEN 55800'printer log
  118. 20200  IF C=94 THEN 57700'exchange lines 3 and 9
  119. 20300  IF C=95 THEN 59500'print fk list
  120. 20400  IF C=96 THEN ET=1:GOSUB 46600:FOR N=1 TO 6:TA(N)=A1(N):NEXT N:GOTO 59200'time to line 3
  121. 20500  IF C=97 THEN ET=1:GOSUB 47500:FOR N=1 TO 6:TA(N)=A2(N):NEXT N:GOTO 59200'time to line 3
  122. 20600  IF C=98 THEN AD=376:GOTO 60000'day of year to line 3
  123. 20700  IF C=99 THEN AD=1336:GOTO 60000'day of year to line 9
  124. 20800  IF C=100 THEN SD=1:GOTO 60800'result to date
  125. 20900  IF C=101 THEN SD=0:GOTO 60800'result + date to date
  126. 21000  IF C=102 THEN 17600'unassigned
  127. 21100  IF C=103 THEN 17600'unassigned
  128. 21200  GOTO 17600
  129. 21300  L=CSRLIN:R=POS(0):C=ASC(X$)'---------------single byte keys-------------
  130. 21400  A=(160*(L-1)+2*R-2)
  131. 21500  IF C=8 AND L<>5 THEN 32400' delete
  132. 21600  IF L=5 THEN IF C=32 THEN GOSUB 22000'set function
  133. 21700  IF L<>5 AND C>47 AND C<58 THEN 31900'number entry
  134. 21800  IF L<>5 AND C=46 THEN 31900'decimal point
  135. 21900  GOTO 17600
  136. 22000  LOCATE L,1:GOSUB 28200:LOCATE L,R:ADDRESS=((160*L)-(160-2*R+1)):POKE ADDRESS,(PEEK(ADDRESS) OR &HF0):POKE ADDRESS+2,&H87
  137. 22100  IF R=21 OR R=30 THEN GOSUB 22500:F=1
  138. 22200  IF R=40 OR R=50 THEN GOSUB 22900:F=2
  139. 22300  IF R=65 THEN GOSUB 23200:F=12
  140. 22400  RETURN
  141. 22500  FOR A=1009 TO 1067 STEP 2:POKE A,0:NEXT A
  142. 22600  FOR A=1281 TO 1437 STEP 2:GOSUB 23400:NEXT A
  143. 22700  FOR A=961 TO 1009 STEP 2:GOSUB 23400:NEXT A
  144. 22800  FOR N=1 TO 12:READ A:NEXT N:FOR N=1 TO 6:READ A:POKE A+1,0:NEXT N:RESTORE:RETURN
  145. 22900  FOR A=1281 TO 1437 STEP 2:POKE A,0:NEXT A
  146. 23000  FOR A=961 TO 1059 STEP 2:GOSUB 23400:NEXT A
  147. 23100  POKE 1037,0:RETURN
  148. 23200  FOR A=1281 TO 1437 STEP 2:POKE A,0:NEXT A
  149. 23300  FOR A=961 TO 1067 STEP 2:POKE A,0:NEXT A:RETURN
  150. 23400  K=PEEK(A-1)
  151. 23500  IF K=46 OR (K>47 AND K<58) THEN POKE A,&H70 ELSE POKE A,&H7
  152. 23600  GOTO 44700
  153. 23700  RETURN
  154. 23800  '---------------------cursor up----------------------------
  155. 23900  IF L=5 THEN LOCATE 3,51:GOSUB 24500
  156. 24000  IF L=7 THEN LOCATE 5,21:GOSUB 24400
  157. 24100  IF L=9 AND F=1 THEN LOCATE 5,21:GOSUB 24400
  158. 24200  IF L=9 AND F><1 THEN LOCATE 7,38
  159. 24300  RETURN
  160. 24400  LIN=CSRLIN:COL=POS(0):LOCATE 25,1:COLOR 0,7:PRINT MES$(3);:COLOR 7,0:LOCATE LIN,COL:RETURN
  161. 24500  LIN=CSRLIN:COL=POS(0):LOCATE 25,1:COLOR 0,7:PRINT MES$(2);:COLOR 7,0:LOCATE LIN,COL:RETURN
  162. 24600  '---------------------cursor left--------------------------
  163. 24700  IF L=3 OR L=9 THEN 25000
  164. 24800  IF L=5 THEN 25600
  165. 24900  RETURN
  166. 25000  IF R=16 THEN LOCATE ,4
  167. 25100  IF R=28 THEN LOCATE ,16
  168. 25200  IF R=39 THEN LOCATE ,28
  169. 25300  IF R=51 THEN LOCATE ,39
  170. 25400  IF R=71 THEN LOCATE ,51
  171. 25500  RETURN
  172. 25600  IF R=30 THEN LOCATE ,21
  173. 25700  IF R=40 THEN LOCATE ,30
  174. 25800  IF R=50 THEN LOCATE ,40
  175. 25900  IF R=65 THEN LOCATE ,50
  176. 26000  RETURN
  177. 26100  '---------------------cursor right-------------------------
  178. 26200  IF L=3 OR L=9 THEN 26500
  179. 26300  IF L=5 THEN 27100
  180. 26400  RETURN
  181. 26500  IF R=4 THEN LOCATE ,16
  182. 26600  IF R=16 THEN LOCATE ,28
  183. 26700  IF R=28 THEN LOCATE ,39
  184. 26800  IF R=39 THEN LOCATE ,51
  185. 26900  IF R=51 THEN LOCATE ,71
  186. 27000  RETURN
  187. 27100  IF R=21 THEN LOCATE ,30
  188. 27200  IF R=30 THEN LOCATE ,40
  189. 27300  IF R=40 THEN LOCATE ,50
  190. 27400  IF R=50 THEN LOCATE ,65
  191. 27500  RETURN
  192. 27600  '---------------------cursor down--------------------------
  193. 27700  IF L=3 THEN LOCATE 5,21:GOSUB 24400
  194. 27800  IF L=5 AND F=1 THEN LOCATE 9,51:GOSUB 24500
  195. 27900  IF L=5 AND (F=0 OR F=2) THEN LOCATE 7,38:GOSUB 24500
  196. 28000  IF L=7 AND F=0 THEN LOCATE 9,51
  197. 28100  RETURN
  198. 28200  PRINT "Choose a function:  ";:COLOR 0,7:PRINT "+";:COLOR 7,0:PRINT " PLUS,  ";
  199. 28300  COLOR 0,7:PRINT "-";:COLOR 7,0:PRINT " MINUS,  ";
  200. 28400  COLOR 0,7:PRINT "*";:COLOR 7,0:PRINT " TIMES,  ";
  201. 28500  COLOR 0,7:PRINT "/";:COLOR 7,0:PRINT " DIVIDED BY,  ";
  202. 28600  COLOR 0,7:PRINT CHR$(15);:COLOR 7,0:PRINT " BREAKDOWN.";
  203. 28700  FOR N=1 TO 5:READ A:POKE A,60:POKE A+1,&H0:NEXT N:RESTORE
  204. 28800  RETURN
  205. 28900  'function selection, line 5
  206. 29000  DATA 682,700,720,740,770
  207. 29100  'first input data line, line 3, start at 6
  208. 29200  DATA 328,352,376,398,422,462
  209. 29300  'constant, line 7, start at 12
  210. 29400  DATA 1036
  211. 29500  'second input data line, line 9, start at 13
  212. 29600  DATA 1288,1312,1336,1358,1382,1422
  213. 29700  'result year, 19
  214. 29800  DATA 1926
  215. 29900  'result week, 20
  216. 30000  DATA 1950
  217. 30100  'result day, 21
  218. 30200  DATA 1974,2294
  219. 30300  'result hour, 23
  220. 30400  DATA 1996,2316,2636
  221. 30500  'result minute, 26
  222. 30600  DATA 2020,2340,2660,2980
  223. 30700  'result second, 30
  224. 30800  DATA 2064,2384,2704,3024,3344
  225. 30900  'result totals, 35
  226. 31000  DATA 1652,1694,1736,2902,3222,3542
  227. 31100  'result cumulative units, 41
  228. 31200  DATA 2270,2614,2956,3300,3664
  229. 31300  FOR N=1 TO 18'------------install invisible pointers------------------
  230. 31400  READ A
  231. 31500  POKE A,60:POKE A+1,0
  232. 31600  NEXT N
  233. 31700  RESTORE:RETURN
  234. 31800  IF L=5 THEN IF C=32 THEN LOCATE L,1:GOSUB 28200:LOCATE L,R:ADDRESS=((160*L)-(160-2*R+1)):POKE ADDRESS,(PEEK(ADDRESS) OR &HF0):POKE ADDRESS+2,&H87
  235. 31900  S=0'----------------------------number entry-----------------------
  236. 32000  T=PEEK(A+1) OR &H8F:IF T=&HFF THEN A=A-2:S=S+1:IF S>9 THEN 17600 ELSE 32000
  237. 32100  FOR N=1 TO S:A=A+2:POKE A-2,PEEK(A):POKE A-1,PEEK(A+1):NEXT N
  238. 32200  POKE A,C:POKE A+1,&H70
  239. 32300  GOTO 17600
  240. 32400  AA=A'---------------------------delete----------------------------------
  241. 32500  T=PEEK(AA-1) OR &H8F:IF T=&HFF THEN POKE AA,PEEK(AA-2):AA=AA-2:GOTO 32500 ELSE POKE AA,219:POKE AA+1,&H7:GOTO 17600
  242. 32600  O=0'-----------------------enter---------------------------------------
  243. 32700  FOR N=1 TO 5'----------determine operation-------------
  244. 32800  READ A:B=PEEK(A-1) AND &H80
  245. 32900  IF B=&H80 THEN O=N' ---0=none,1=+,2=-,3=*,4=/,5=breakdown----------
  246. 33000  NEXT N
  247. 33100  FOR N=1 TO 6'  -----------------check for 1st number----------------
  248. 33200  READ A:V=PEEK(A-1) AND &H70
  249. 33300  IF V=&H70 THEN RESTORE:GOTO 33600
  250. 33400  NEXT N
  251. 33500  RESTORE:GOTO 17600
  252. 33600  IF O=5 OR O=0 THEN RESTORE:GOTO 34500
  253. 33700  READ A:V=PEEK(A-1) AND &H70'-----------------check for 2nd number----
  254. 33800  IF O>2 AND V=&H70 THEN RESTORE:GOTO 34500
  255. 33900  IF O>2 THEN RESTORE:GOTO 17600
  256. 34000  FOR N=1 TO 6' ------------------check for 3rd number--------------
  257. 34100  READ A:V=PEEK(A-1) AND &H70
  258. 34200  IF V=&H70 THEN RESTORE:GOTO 34500
  259. 34300  NEXT N
  260. 34400  RESTORE:GOTO 17600
  261. 34500  '------------------read data-----------------------------
  262. 34600  FOR N=1 TO 5:READ D:NEXT N' ---skip operation line---
  263. 34700  N=0
  264. 34800  N=N+1:IF N=7 THEN 35700 '--------read 1st line-------------
  265. 34900  READ A:GOSUB 37100' extract data from screen
  266. 35000  ON N GOTO 35100,35200,35300,35400,35500,35600
  267. 35100  Y#(1)=N#:GOTO 34800
  268. 35200  W#(1)=N#:GOTO 34800
  269. 35300  D#(1)=N#:GOTO 34800
  270. 35400  H#(1)=N#:GOTO 34800
  271. 35500  M#(1)=N#:GOTO 34800
  272. 35600  S#(1)=N#:GOTO 34800
  273. 35700  IF O=5 OR O=0 THEN RESTORE:GOTO 38100'calculate
  274. 35800  READ A
  275. 35900  IF O=3 OR O=4 THEN GOSUB 37100:C#=N#:RESTORE:GOTO 38100
  276. 36000  N=0
  277. 36100  N=N+1:IF N=7 THEN 37000'--------read last line-------------
  278. 36200  READ A:GOSUB 37100' extract data from screen
  279. 36300  ON N GOTO 36400,36500,36600,36700,36800,36900
  280. 36400  Y#(2)=N#:GOTO 36100
  281. 36500  W#(2)=N#:GOTO 36100
  282. 36600  D#(2)=N#:GOTO 36100
  283. 36700  H#(2)=N#:GOTO 36100
  284. 36800  M#(2)=N#:GOTO 36100
  285. 36900  S#(2)=N#:GOTO 36100
  286. 37000  RESTORE:GOTO 38100' calculate
  287. 37100  Y=A-2:Q=0:S=0:U=0:W=0:N#=0'----------extract data from the screen-
  288. 37200  T=PEEK(Y+1) OR &H8F
  289. 37300  IF T=&HFF THEN Y=Y-2:S=S+1:GOTO 37200
  290. 37400  FOR M=1 TO S
  291. 37500  W=PEEK(Y+2*M):IF W=46 THEN U=S-M:Q=1:GOTO 37800
  292. 37600  NUM=VAL(CHR$(PEEK(Y+2*M)))
  293. 37700  N#=N#+NUM*10^(S-M+Q)
  294. 37800  NEXT M
  295. 37900  IF Q=1 THEN N#=N#/10^(U+1)
  296. 38000  RETURN
  297. 38100  '--------------------calculations----------------------------------
  298. 38200  IF O=5 OR O=0 THEN G=1:H=3:GOSUB 38700:GOTO 39600'convert input;sum up result
  299. 38300  IF O=4 THEN Y#(6)=Y#(1)/C#:W#(6)=W#(1)/C#:D#(6)=D#(1)/C#:H#(6)=H#(1)/C#:M#(6)=M#(1)/C#:S#(6)=S#(1)/C#:G=6:H=3:GOSUB 38700:GOTO 39600
  300. 38400  IF O=3 THEN Y#(6)=Y#(1)*C#:W#(6)=W#(1)*C#:D#(6)=D#(1)*C#:H#(6)=H#(1)*C#:M#(6)=M#(1)*C#:S#(6)=S#(1)*C#:G=6:H=3:GOSUB 38700:GOTO 39600
  301. 38500  IF O=2 THEN Y#(6)=Y#(1)-Y#(2):W#(6)=W#(1)-W#(2):D#(6)=D#(1)-D#(2):H#(6)=H#(1)-H#(2):M#(6)=M#(1)-M#(2):S#(6)=S#(1)-S#(2):G=6:H=3:GOSUB 38700:GOTO 39600
  302. 38600  IF O=1 THEN Y#(6)=Y#(1)+Y#(2):W#(6)=W#(1)+W#(2):D#(6)=D#(1)+D#(2):H#(6)=H#(1)+H#(2):M#(6)=M#(1)+M#(2):S#(6)=S#(1)+S#(2):G=6:H=3:GOSUB 38700:GOTO 39600
  303. 38700  '---------------------convert to time units------g=in - h=out-----
  304. 38800  S#(0)=S#(G)+M#(G)*60+H#(G)*3600+D#(G)*86400+W#(G)*604800+Y#(G)*3.1536E+07
  305. 38900  IF S#(0)<0 THEN MS=35:RETURN 60500'result negative error message
  306. 39000  Y#(H)=INT(S#(0)/3.1536E+07):S#(0)=S#(0)-Y#(H)*3.1536E+07
  307. 39100  D#(H)=INT(S#(0)/86400):S#(0)=S#(0)-D#(H)*86400
  308. 39200  W#(H)=INT(D#(H)/7):D#(H)=D#(H)-W#(H)*7
  309. 39300  H#(H)=INT(S#(0)/3600):S#(0)=S#(0)-H#(H)*3600
  310. 39400  M#(H)=INT(S#(0)/60):S#(H)=S#(0)-M#(H)*60
  311. 39500  RETURN
  312. 39600  '--------------sum up result--------------------------------------
  313. 39700  GOSUB 44400' clear result fields
  314. 39800  GOSUB 41700' print result  items 3
  315. 39900  Y#(4)=Y#(3)+W#(3)*7/365+D#(3)/365+H#(3)/8760+M#(3)/525600+S#(3)/3.1536E+07
  316. 40000  W#(4)=Y#(3)*52.1429+W#(3)+D#(3)/7+H#(3)/168+M#(3)/10080+S#(3)/604800
  317. 40100  D#(4)=Y#(3)*365+W#(3)*7+D#(3)+H#(3)/24+M#(3)/1440+S#(3)/86400
  318. 40200  H#(4)=Y#(3)*8760+W#(3)*168+D#(3)*24+H#(3)+M#(3)/60+S#(3)/3600
  319. 40300  M#(4)=Y#(3)*525600+W#(3)*10080+D#(3)*1440+H#(3)*60+M#(3)+S#(3)/60
  320. 40400  S#(4)=Y#(3)*3.1536E+07+W#(3)*604800+D#(3)*86400+H#(3)*3600+M#(3)*60+S#(3)
  321. 40500  Y!(4)=Y#(4):W!(4)=W#(4):D!(4)=D#(4):H!(4)=H#(4):M!(4)=M#(4):S!(4)=S#(4)
  322. 40600  GOSUB 42600' print result  items 4
  323. 40700  Y#(5)=Y#(3):YW#=(Y#(5)*52.1429)
  324. 40800  W#(5)=INT(YW#)+W#(3):WD#=(YW#-INT(YW#))*7:WD=WD#
  325. 40900  D#(5)=INT(W#(5))*7+D#(3)+WD:DFW#=D#(3)+WD#:DFW=DFW#
  326. 41000  IF DFW>=7 THEN W#(5)=W#(5)+INT(DFW/7):DFW=DFW MOD 7
  327. 41100  H#(5)=D#(5)*24+H#(3)
  328. 41200  M#(5)=H#(5)*60+M#(3)
  329. 41300  S#(5)=M#(5)*60+S#(3)
  330. 41400  GOSUB 43300' print result  items 5
  331. 41500  RESTORE:IF LG=1 THEN GOSUB 56000
  332. 41600  L=CSRLIN:R=POS(0):LOCATE 25,1:COLOR 0,7:PRINT MES$(4);:COLOR 7,0:LOCATE L,R:GOTO 17600
  333. 41700  FOR N=1 TO 18:READ D:NEXT N' --------print result data 3--------------
  334. 41800  Y!(3)=Y#(3):W!(3)=W#(3):D!(3)=D#(3):H!(3)=H#(3):M!(3)=M#(3):S!(3)=S#(3)
  335. 41900  VALU$=STR$(Y!(3)):READ A:GOSUB 44000'write string
  336. 42000  VALU$=STR$(W!(3)):READ A:GOSUB 44000
  337. 42100  VALU$=STR$(D!(3)):READ A:GOSUB 44000:READ A
  338. 42200  VALU$=STR$(H!(3)):FOR I=1 TO 3:READ A:GOSUB 44000:NEXT I
  339. 42300  VALU$=STR$(M!(3)):FOR I=1 TO 4:READ A:GOSUB 44000:NEXT I
  340. 42400  VALU$=STR$(S!(3)):FOR I=1 TO 5:READ A:GOSUB 44000:NEXT I
  341. 42500  RETURN
  342. 42600  VALU$=STR$(Y!(4)):READ A:GOSUB 44000'write string
  343. 42700  VALU$=STR$(W!(4)):READ A:GOSUB 44000
  344. 42800  VALU$=STR$(D!(4)):READ A:GOSUB 44000
  345. 42900  VALU$=STR$(H!(4)):READ A:GOSUB 44000
  346. 43000  VALU$=STR$(M!(4)):READ A:GOSUB 44000
  347. 43100  VALU$=STR$(S!(4)):READ A:GOSUB 44000
  348. 43200  RETURN
  349. 43300  VALU$=STR$(W#(5)):READ A:GOSUB 44000
  350. 43400  VALU$=STR$(DFW):A=2294:GOSUB 44000
  351. 43500  VALU$=STR$(D#(5)):READ A:GOSUB 44000
  352. 43600  VALU$=STR$(H#(5)):READ A:GOSUB 44000
  353. 43700  VALU$=STR$(M#(5)):READ A:GOSUB 44000
  354. 43800  VALU$=STR$(S#(5)):READ A:GOSUB 44000
  355. 43900  RETURN
  356. 44000  IF VAL(VALU$)=0 AND ET=0 AND DT=0 THEN RETURN'-----------write string---------
  357. 44100  J=LEN(VALU$)-1
  358. 44200  FOR N=1 TO J:CH$=MID$(VALU$,N+1,1):POKE A+2*(N-J),ASC(CH$):POKE A+2*(N-J)+1,&H70:NEXT N
  359. 44300  RETURN
  360. 44400  FOR N=1 TO 18:READ D:NEXT N'--------------clear result fields-------
  361. 44500  FOR N= 1 TO 27:READ A:GOSUB 44800:NEXT N' clear field
  362. 44600  A=3620:GOSUB 44800' clear date field
  363. 44700  RESTORE:RETURN
  364. 44800  '-----------------------------clear field-----------------------
  365. 44900  IF PEEK(A+1)=&H70 THEN POKE A,219:POKE A+1,&H7:A=A-2:GOTO 44900
  366. 45000  RETURN
  367. 45100  FK=3'---------------------list function key functions-------------------
  368. 45200  FK=FK+1:IF FK>34 THEN 45500
  369. 45300  LOCATE 25,1:COLOR 0,7:PRINT MES$(FK);
  370. 45400  X$=INKEY$:IF X$="" THEN 45400 ELSE IF X$=CHR$(27) THEN 15600 ELSE IF LEN(X$)>1 AND ASC(RIGHT$(X$,1))=104 THEN 45200 ELSE 45500
  371. 45500  COLOR 7,0:LOCATE L,R:GOTO 17700
  372. 45600  GOSUB 46900'get ar(n)'----------transfer result to data 1--------------
  373. 45700  IF C=106 THEN GOSUB 46600:FOR N=1 TO 6:AT(N)=A1(N):NEXT N'get a1(n)
  374. 45800  IF C=108 THEN GOSUB 47500:FOR N=1 TO 6:AT(N)=A2(N):NEXT N'get a2(n)
  375. 45900  FOR NN=1 TO 6
  376. 46000  A=AT(NN)-2:GOSUB 44800'clear field
  377. 46100  A=AR(NN)+2:GOSUB 37100'read field
  378. 46200  N!=N#:VALU$=STR$(N!)
  379. 46300  A=AT(NN)-2:GOSUB 44000'write string
  380. 46400  NEXT NN
  381. 46500  GOTO 17600
  382. 46600  FOR N=1 TO 5:READ D:NEXT N'----read addresses for data line 1 (line 3)--
  383. 46700  FOR N=1 TO 6:READ A1(N):NEXT N
  384. 46800  RESTORE:RETURN
  385. 46900  FOR N=1 TO 18:READ D:NEXT N'----read addresses for result (line 13)-----
  386. 47000  FOR N=1 TO 3:READ AR(N):NEXT N
  387. 47100  READ D:READ AR(4)
  388. 47200  READ D:READ D:READ AR(5)
  389. 47300  FOR N=1 TO 3:READ D:NEXT N:READ AR(6)
  390. 47400  RESTORE:RETURN
  391. 47500  FOR N=1 TO 12:READ D:NEXT N'-----read addresses for data line 2 (line 9)-
  392. 47600  FOR N=1 TO 6:READ A2(N):NEXT N
  393. 47700  RESTORE:RETURN
  394. 47800  FOR N=1 TO 11:READ D:NEXT N:READ AC(1)'---address of constant-----------
  395. 47900  RESTORE:RETURN
  396. 48000  '------------------------clear line----------------------------------
  397. 48100  IF L=3 THEN GOSUB 46600:FOR N=1 TO 6:A=A1(N)-2:GOSUB 44800:NEXT N:GOTO 17600
  398. 48200  IF L=9 THEN GOSUB 47500:FOR N=1 TO 6:A=A2(N)-2:GOSUB 44800:NEXT N:GOTO 17600
  399. 48300  IF L=7 THEN GOSUB 47800:A=AC(1)-2:GOSUB 44800:GOTO 17600
  400. 48400  ON ERROR GOTO 59700'-------print report----------------------------
  401. 48500  LPRINT CHR$(27)CHR$(64)CHR$(14)CHR$(27)CHR$(45)CHR$(1)CHR$(27)CHR$(69)CHR$(27)CHR$(48)"THIS"SPC(9);
  402. 48600  IF O=0 OR O=5 THEN LPRINT "IS THE SAME AS":LPRINT:GOTO 49200
  403. 48700  IF O=1 THEN LPRINT "PLUS      ";
  404. 48800  IF O=2 THEN LPRINT "MINUS     ";
  405. 48900  IF O=3 THEN LPRINT "TIMES     ";
  406. 49000  IF O=4 THEN LPRINT "DIVIDED BY";
  407. 49100  LPRINT SPC(7)"EQUALS":LPRINT
  408. 49200  LPRINT CHR$(27)CHR$(70)CHR$(27)CHR$(45)CHR$(0)CHR$(15);
  409. 49300  PR$="#.###############^^^^"
  410. 49400  IF O=0 OR O=5 THEN 50300
  411. 49500  IF O=3 OR O=4 THEN 51000
  412. 49600  LPRINT USING PR$;Y#(1);:LPRINT " years"SPC(21);:LPRINT USING PR$;Y#(2);:LPRINT " years"SPC(21);:LPRINT USING PR$;Y#(3);:LPRINT " years":LPRINT
  413. 49700  LPRINT USING PR$;W#(1);:LPRINT " weeks"SPC(21);:LPRINT USING PR$;W#(2);:LPRINT " weeks"SPC(21);:LPRINT USING PR$;W#(3);:LPRINT " weeks":LPRINT
  414. 49800  LPRINT USING PR$;D#(1);:LPRINT " days"SPC(22);:LPRINT USING PR$;D#(2);:LPRINT " days"SPC(22);:LPRINT USING PR$;D#(3);:LPRINT " days":LPRINT
  415. 49900  LPRINT USING PR$;H#(1);:LPRINT " hours"SPC(21);:LPRINT USING PR$;H#(2);:LPRINT " hours"SPC(21);:LPRINT USING PR$;H#(3);:LPRINT " hours":LPRINT
  416. 50000  LPRINT USING PR$;M#(1);:LPRINT " minutes"SPC(19);:LPRINT USING PR$;M#(2);:LPRINT " minutes"SPC(19);:LPRINT USING PR$;M#(3);:LPRINT " minutes":LPRINT
  417. 50100  LPRINT USING PR$;S#(1);:LPRINT " seconds"SPC(19);:LPRINT USING PR$;S#(2);:LPRINT " seconds"SPC(19);:LPRINT USING PR$;S#(3);:LPRINT " seconds":LPRINT
  418. 50200  GOTO 51700
  419. 50300  LPRINT USING PR$;Y#(1);:LPRINT " years"SPC(21);:LPRINT USING PR$;Y#(3);:LPRINT " years":LPRINT
  420. 50400  LPRINT USING PR$;W#(1);:LPRINT " weeks"SPC(21);:LPRINT USING PR$;W#(3);:LPRINT " weeks":LPRINT
  421. 50500  LPRINT USING PR$;D#(1);:LPRINT " days"SPC(22);:LPRINT USING PR$;D#(3);:LPRINT " days":LPRINT
  422. 50600  LPRINT USING PR$;H#(1);:LPRINT " hours"SPC(21);:LPRINT USING PR$;H#(3);:LPRINT " hours":LPRINT
  423. 50700  LPRINT USING PR$;M#(1);:LPRINT " minutes"SPC(19);:LPRINT USING PR$;M#(3);:LPRINT " minutes":LPRINT
  424. 50800  LPRINT USING PR$;S#(1);:LPRINT " seconds"SPC(19);:LPRINT USING PR$;S#(3);:LPRINT " seconds":LPRINT
  425. 50900  GOTO 51700
  426. 51000  LPRINT USING PR$;Y#(1);:LPRINT " years"SPC(70);:LPRINT USING PR$;Y#(3);:LPRINT " years":LPRINT
  427. 51100  LPRINT USING PR$;W#(1);:LPRINT " weeks"SPC(70);:LPRINT USING PR$;W#(3);:LPRINT " weeks":LPRINT
  428. 51200  LPRINT USING PR$;D#(1);:LPRINT " days"SPC(22);:LPRINT USING PR$;C#;:LPRINT SPC(27);:LPRINT USING PR$;D#(3);:LPRINT " days":LPRINT
  429. 51300  LPRINT USING PR$;H#(1);:LPRINT " hours"SPC(70);:LPRINT USING PR$;H#(3);:LPRINT " hours":LPRINT
  430. 51400  LPRINT USING PR$;M#(1);:LPRINT " minutes"SPC(66);:LPRINT USING PR$;M#(3);:LPRINT " minutes":LPRINT
  431. 51500  LPRINT USING PR$;S#(1);:LPRINT " seconds"SPC(66);:LPRINT USING PR$;S#(3);:LPRINT " seconds":LPRINT
  432. 51600  GOTO 51700
  433. 51700  LPRINT CHR$(18)CHR$(27)CHR$(87)CHR$(1)CHR$(27)CHR$(45)CHR$(1)CHR$(27)CHR$(69);
  434. 51800  LPRINT "IN INDIVIDUAL UNITS, THE RESULTS ARE:"
  435. 51900  LPRINT CHR$(27)CHR$(70)CHR$(27)CHR$(45)CHR$(0)CHR$(27)CHR$(50)CHR$(15)
  436. 52000  K=4:GOSUB 52600
  437. 52100  LPRINT:LPRINT CHR$(18)CHR$(27)CHR$(69)CHR$(27)CHR$(45)CHR$(1);
  438. 52200  LPRINT "THE GREATEST INTEGRAL UNIT QUANTITIES:"
  439. 52300  LPRINT CHR$(27)CHR$(70)CHR$(27)CHR$(45)CHR$(0)CHR$(27)CHR$(50)CHR$(15);
  440. 52400  K=5:GOSUB 52600
  441. 52500  FOR N=1 TO 5:LPRINT:NEXT N:ON ERROR GOTO 0:GOTO 17600
  442. 52600  LPRINT USING PR$;Y#(K);:LPRINT " YEARS"
  443. 52700  LPRINT USING PR$;W#(K);:LPRINT " WEEKS"
  444. 52800  LPRINT USING PR$;D#(K);:LPRINT " DAYS"
  445. 52900  LPRINT USING PR$;H#(K);:LPRINT " HOURS"
  446. 53000  LPRINT USING PR$;M#(K);:LPRINT " MINUTES"
  447. 53100  LPRINT USING PR$;S#(K);:LPRINT " SECONDS"
  448. 53200  RETURN
  449. 53300  GOSUB 46600'------------------save data line 1-----------------------
  450. 53400  FOR NN=1 TO 6:A=A1(NN):GOSUB 37100:DAT1#(NN)=N#:NEXT NN
  451. 53500  GOTO 17600
  452. 53600  GOSUB 46600'------------------restore data line 1--------------------
  453. 53700  FOR NN=1 TO 6:A=A1(NN)-2:VALU$=STR$(DAT1#(NN)):GOSUB 44000:NEXT NN
  454. 53800  GOTO 17600
  455. 53900  GOSUB 47800'------------------save constant--------------------------
  456. 54000  A=AC(1):GOSUB 37100:CONS#(1)=N#
  457. 54100  GOTO 17600
  458. 54200  GOSUB 47800'------------------restore constant------------------------
  459. 54300  A=AC(1)-2:VALU$=STR$(CONS#(1)):GOSUB 44000
  460. 54400  GOTO 17600
  461. 54500  GOSUB 47500'------------------save data line 2-----------------------
  462. 54600  FOR NN=1 TO 6:A=A2(NN):GOSUB 37100:DAT2#(NN)=N#:NEXT NN
  463. 54700  GOTO 17600
  464. 54800  GOSUB 47500'------------------restore data line 2--------------------
  465. 54900  FOR NN=1 TO 6:A=A2(NN)-2:VALU$=STR$(DAT2#(NN)):GOSUB 44000:NEXT NN
  466. 55000  GOTO 17600
  467. 55100  GOSUB 46900'------------------save result----------------------------
  468. 55200  FOR NN=1 TO 6:A=AR(NN)+2:GOSUB 37100:RESL#(NN)=N#:NEXT NN
  469. 55300  GOTO 17600
  470. 55400  GOSUB 46900'------------------restore result-------------------------
  471. 55500  FOR NN=1 TO 6:A=AR(NN):VALU$=STR$(RESL#(NN)):GOSUB 44000:NEXT NN
  472. 55600  GOTO 17600
  473. 55700  '         SAVE"timecalc",a
  474. 55800  '----------------------------provide printer log-------------------------
  475. 55900  IF LG=0 THEN LG=1:GOTO 17600 ELSE LG=0:GOTO 17600
  476. 56000  ON ERROR GOTO 59700:LPRINT CHR$(27)CHR$(64)CHR$(15);
  477. 56100  L$(1)="y,":L$(2)="w,":L$(3)="d,":L$(4)="h,":L$(5)="m,":L$(6)="s."
  478. 56200  GOSUB 46600
  479. 56300  FOR NN=1 TO 6:A=A1(NN):GOSUB 37100:IF N#=0 THEN 56400 ELSE LPRINT N#;L$(NN);
  480. 56400  NEXT NN
  481. 56500  IF O=0 OR O=5 THEN LPRINT " CONVERTS TO:  ";:GOSUB 46900:GOTO 57300
  482. 56600  IF O=1 THEN LPRINT " PLUS ";:GOSUB 47500:GOTO 57000
  483. 56700  IF O=2 THEN LPRINT " MINUS ";:GOSUB 47500:GOTO 57000
  484. 56800  IF O=3 THEN LPRINT " TIMES ";:GOSUB 47800:GOTO 57600
  485. 56900  IF O=4 THEN LPRINT " DIVIDED BY ";:GOSUB 47800:GOTO 57600
  486. 57000  FOR NN=1 TO 6:A=A2(NN):GOSUB 37100:IF N#=0 THEN 57100 ELSE LPRINT N#;L$(NN);
  487. 57100  NEXT NN
  488. 57200  LPRINT " EQUALS ";:GOSUB 46900
  489. 57300  FOR NN=1 TO 6:A=AR(NN)+2:GOSUB 37100:IF N#=0 THEN 57400 ELSE LPRINT N#;L$(NN);
  490. 57400  NEXT NN
  491. 57500  LPRINT:ON ERROR GOTO 0:GOTO 17600
  492. 57600  A=AC(1):GOSUB 37100:LPRINT N#;:GOTO 57200
  493. 57700  GOSUB 47500'get a2(n)----------------------exchange lines 3 & 9---------
  494. 57800  FOR NN=1 TO 6:A=A2(NN):GOSUB 37100:TMP2#(NN)=N#:NEXT NN
  495. 57900  GOSUB 46600'get a1(n)
  496. 58000  FOR NN=1 TO 6'transfer data 1 to data 2
  497. 58100  A=A2(NN)-2:GOSUB 44800'clear field
  498. 58200  A=A1(NN):GOSUB 37100'read field
  499. 58300  IF N#=0 THEN 58500 ELSE VALU$=STR$(N#)
  500. 58400  A=A2(NN)-2:GOSUB 44000'write string
  501. 58500  NEXT NN
  502. 58600  FOR NN=1 TO 6'transfer temp 2 to data 1
  503. 58700  A=A1(NN)-2:GOSUB 44800'clear field
  504. 58800  IF TMP2#(NN)=0 THEN 59000 ELSE VALU$=STR$(TMP2#(NN))
  505. 58900  A=A1(NN)-2:GOSUB 44000'write string
  506. 59000  NEXT NN
  507. 59100  GOTO 17600
  508. 59200  '------------------------------enter time and date---------------------
  509. 59300  TI$=TIME$:TI(6)=VAL(RIGHT$(TI$,2)):TI(5)=VAL(MID$(TI$,4,2)):TI(4)=VAL(LEFT$(TI$,2))
  510. 59400  FOR NN=4 TO 6:A=TA(NN)-2:VALU$="  "+STR$(TI(NN)):GOSUB 44000:NEXT NN:GOTO 17600
  511. 59500  ON ERROR GOTO 59700:LPRINT CHR$(27)CHR$(64)CHR$(27)CHR$(69)CHR$(27)CHR$(45)CHR$(1)"  LIST OF FUNCTION KEY FUNCTIONS for TIMECALC.":LPRINT CHR$(27)CHR$(45)CHR$(0)CHR$(27)CHR$(52)
  512. 59600  FOR N=4 TO 34:LPRINT MES$(N):LPRINT:NEXT N:LPRINT CHR$(12):ON ERROR GOTO 0:GOTO 17600
  513. 59700  L=CSRLIN:R=POS(0):COLOR 0,7'--------printer error message----------------
  514. 59800  FOR N=1 TO 15:LOCATE 25,1:PRINT MES$(36);:LOCATE 25,1:PRINT MES$(37);:NEXT N
  515. 59900  LOCATE L,R:RESUME 17600
  516. 60000  DT$=DATE$'----------------enter day of year-----------------------------
  517. 60100  MY=VAL(LEFT$(DT$,2)):DY=VAL(MID$(DT$,4,2)):YY=VAL(RIGHT$(DT$,2))+1900
  518. 60200  IF MY>=3 THEN D2!=INT((MY+1)*30.6):D1!=INT(365.25*YY) ELSE D2!=INT((MY+13)*30.6):D1!=INT(365.25*(YY-1))
  519. 60300  DT!=DY+D1!+D2!-INT(365.25*(YY-1))-429
  520. 60400  VALU$=STR$(DT!):A=AD-2:GOSUB 44000:GOTO 17600
  521. 60500  L=CSRLIN:R=POS(0):COLOR 0,7'--------negative result error message--------
  522. 60600  FOR N=1 TO 15:LOCATE 25,1:PRINT MES$(MS);:LOCATE 25,1:PRINT MES$(37);:NEXT N
  523. 60700  LOCATE L,R:GOTO 17600
  524. 60800  SDAT$=DATE$:IF SD=1 THEN DAT$="01-01-"+RIGHT$(DATE$,4) ELSE DAT$=DATE$
  525. 60900  DYS=INT(D!(3))+INT(W!(3))*7:IF DYS<1 THEN DYS=0
  526. 61000  Y=VAL(RIGHT$(DAT$,4)):D=VAL(MID$(DAT$,4,2)):M=VAL(LEFT$(DAT$, 2))
  527. 61100  Y=Y+Y!(3):DYS=DYS-INT(Y!(3)/4):IF Y>2099 THEN 62100
  528. 61200  IF DYS<=-1 THEN Y=Y-1:DYS=DYS+365
  529. 61300  FOR N=1 TO DYS
  530. 61400  D=D+1
  531. 61500  M$=STR$(M+100):D$=STR$(D+100):Y$=STR$(Y+10000):M$=RIGHT$(M$,2):D$=RIGHT$(D$,2):Y$=RIGHT$(Y$,4)
  532. 61600  ATE$=M$+"-"+D$+"-"+Y$:ON ERROR GOTO 61800:DATE$=ATE$
  533. 61700  ON ERROR GOTO 0:GOTO 62200
  534. 61800  IF ERR=5 THEN RESUME 61900 ELSE PRINT "DATGEN TROUBLE":ON ERROR GOTO 0
  535. 61900  D=1:M=M+1:IF M=13 THEN 62000 ELSE 62200
  536. 62000  M=1:Y=Y+1:IF Y>=2099 THEN 62100 ELSE 62200
  537. 62100  A=3620:VALU$=" Cannot go beyond 2099":DT=1:GOSUB 44000:DT=0:DATE$=SDAT$:GOTO 62700
  538. 62200  NEXT N
  539. 62300  M4=M:Y4=Y:IF M4>2 THEN 62400 ELSE M4=M4+12:Y4=Y4-1
  540. 62400  N=2+D+M4*2+Y4+INT(Y4/4)-INT(Y4/100)+INT(Y4/400)+INT(0.6*(M4+1))
  541. 62500  DN=1+INT(1/2+(N/7-INT(N/7))*7)
  542. 62600  A=3620:VALU$=" "+DN$(DN)+", "+MN$(M)+STR$(D)+","+STR$(Y):DT=1:GOSUB 44800::A=3620:GOSUB 44000:DT=0:DATE$=SDAT$
  543. 62700  GOTO 17600
  544. 65000  '         SAVE"TIMECALC",a
  545.